Map

Column

NENC DFIB Sites
Data updated: 2023-12-14

---
knit: (function(input, ...) {
    rmarkdown::render(
      input,
      output_file = paste0(
        gsub(pattern = "NEY", replacement = paste0(format.Date(Sys.Date(),'%Y%m%d'),'_NEY'), x = xfun::sans_ext(input)),  '.html'
      ),
      envir = globalenv()
    )
  })
title: "NENC"
output: 
    flexdashboard::flex_dashboard:
        source_code: embed
    vertical-layout: scroll

---


```{r setup, include=FALSE}

#fillPage: true
#storyboard: false


library(flexdashboard)  ## dashboard

library(lubridate)      ## dates
library(tidyverse)      ## tidydata
library(glue)           ## text strings
library(readxl)         ## read excel docs
library(odbc)           ##database connections
library(DBI)            ##database connections

## Installing from GIThub
## May need a personal access token (PAT) - see 
## https://docs.github.com/en/enterprise-server@3.4/authentication/keeping-your-account-and-data-secure/creating-a-personal-access-token
## Then use Sys.setenv(GITHUB_PAT = 'xyz') where xyz is your token
##install.packages("remotes")
##Sys.setenv(GITHUB_PAT = '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')
##remotes::install_github("GIScience/openrouteservice-r")
##remotes::install_github("kent37/summarywidget")

library(openrouteservice) ##isochrome
library(rgdal)          ## read spatial data
library(sf)             ##spatial data

library(leaflet)        ## interactive maps
library(crosstalk)      ## map filters
library(htmltools)      ## html tools
library(DT)             ## Data tables
library(summarywidget)  ## crosstalk + text

library(scales)         ## pretty scales
library(fontawesome)    ## icons
library(viridis)        ## colour palette

## Custom function to format numbers, and suppress small numbers
supress <- function(x){ ifelse(between(x,1,5),'<6', comma(x,accuracy = 1)) }

# Foundry file
ExcelWorkbook <-
  "//ntpcts60.nntha.loc/shared_info/CSUs/NECS/Information Services/Analysis/Projects/DFIBS Map/Planning map/Defibs NENC.xlsx"
ExtractDate <- as_date("2023-12-14")

# Lookup
NEY_ICB <- c("NHS North East and North Cumbria Integrated Care Board"
             ,"NHS North East And North Cumbria Integrated Care Board"
             #,"NHS Humber and North Yorkshire Integrated Care Board"
             #,"NHS Humber And North Yorkshire Integrated Care Board"
             #,"NHS South Yorkshire Integrated Care Board"
             #,"NHS West Yorkshire Integrated Care Board"
             ,"North East and North Cumbria"
             #,"Humber and North Yorkshire"
             #,"South Yorkshire"
             #,"West Yorkshire"
             ,"CNE"
             ,"NENC"
             #,"HNY"
             #,"SY"
             #,"WY"
             )

```

```{r geoAPI, include=FALSE,eval=FALSE}

## Get data from GeoJSON ICB 2022 BUC
#data.Eng_ICB_2022_BUC <-
#  readOGR("https://services1.arcgis.com/ESMARspQHYMw9BZ9/arcgis/rest/services/Integrated_Care_Boards_July_2022_EN_BUC_v2/FeatureServer/0/query?outFields=*&where=1%3D1&f=geojson", verbose = FALSE)  %>%
#  st_as_sf() %>% 
#  mutate(NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE ) %>% as.factor())
#
## Save to project
#save(data.Eng_ICB_2022_BUC,file = glue("{getwd()}/Eng_ICB_2022_BUC"))
#
## Get data from GeoJSON MSOA 2011 BSC
#data.MSOA_2021_BSC <-
#  readOGR("https://services1.arcgis.com/ESMARspQHYMw9BZ9/arcgis/rest/services/Middle_Layer_Super_Output_Areas_DEC_2011_EW_BSC_V3/FeatureServer/0/query?where=1%3D1&outFields=OBJECTID,MSOA11CD,MSOA11NM,LONG,LAT&outSR=4326&f=json", verbose = FALSE)  %>%
#  st_as_sf()
#
## Save to project
#save(data.MSOA_2021_BSC,file = glue("{getwd()}/MSOA_2021_BSC"))

### Get data from GeoJSON LSOA 2011 IMD
#data.LSOA_2011_IMD <-
#  readOGR("https://services3.arcgis.com/ivmBBrHfQfDnDf8Q/arcgis/rest/services/Indices_of_Multiple_Deprivation_(IMD)_2019/Fea#tureServer/0/query?where=1%3D1&outFields=*&outSR=4326&f=json", verbose = FALSE)  %>%
#  st_as_sf()
#
### Save to project
#save(data.LSOA_2011_IMD,file = glue("{getwd()}/LSOA_2011_IMD"))


#
## Get data from GeoJSON CCG 2011 BSC
#data.CCG_2021_BSC <-
#  readOGR("https://services1.arcgis.com/ESMARspQHYMw9BZ9/arcgis/rest/services/CCG_APR_2021_EN_BSC_100M/FeatureServer/0/query?where=1%3D1&outFields=CCG21CD,CCG21NM,LONG,LA#T&outSR=4326&f=json", verbose = FALSE)  %>%
#  st_as_sf()
#
## Save to project
#save(data.CCG_2021_BSC,file = glue("{getwd()}/CCG_2021_BSC"))
```


```{r lookup, include = FALSE}

### connection function
#cn_fun <- function(){dbConnect(odbc()
#                               ,Driver = "SQL Server Native Client 11.0"
#                               ,Server = "PDC-SYS-SQL-107.systems.informatix.loc"
#                               ,database = "INFORMATIONTEAM"
#                               ,Trusted_Connection = "yes")}
#
#
### connects to the sql database
#cn <- cn_fun()
#
### MSOA names
#qry <- "SELECT * FROM [UK_Health_Dimensions].[MSOA_Names].[House_Of_Commons_Library_MSOA_Names_SCD] WHERE [Is_Latest] = 1;"
#data.msoa.names <- dbSendQuery(cn, qry) %>% dbFetch() %>%   select(MSOA11_Code,MSOA11_HCL_Name)
#
### disconnects from SQL
#dbDisconnect(cn)
#rm(cn)
#rm(qry)
#rm(cn_fun)

## ICBs
data.lsoa_to_icb.lu <- 
  read_csv('LSOA_to_ICB.csv') %>%
  select(LSOA11CD,ICB22NM) %>% 
  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE)
         ,ICB22NM = ICB22NM %>% str_remove("NHS ") %>% str_remove(" Integrated Care Board"))

### MSOA LU
#data.lsoa_to_msoa.raw <-
#  read_csv('MSOA_LU.csv')%>% 
#  select(-c(FID,OA11CD)) %>% 
#  filter(str_detect(LSOA11CD,'E.+')) %>% 
#  unique() 
#
### Combine
#data.lsoa_to_msoa.lu <-
#  data.lsoa_to_msoa.raw %>% 
#  left_join(data.lsoa_to_icb.lu, by = c('LSOA11CD' = 'LSOA11CD')) %>% 
#  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE)) %>% 
#  group_by(LSOA11CD,LSOA11NM,MSOA11CD,MSOA11NM,LAD20CD,LAD20NM,RGN20CD,RGN20NM) %>%
#  summarise(ICB22NM = first(ICB22NM, order_by = Flag_NEY)) %>% 
#  ungroup() %>% 
#  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE))

#data.msoa.lu <-
#  data.lsoa_to_msoa.lu %>% 
#  group_by(MSOA11CD,MSOA11NM,LAD20CD,LAD20NM,RGN20CD,RGN20NM) %>% 
#  summarise(ICB22NM = first(ICB22NM, order_by = Flag_NEY)) %>% 
#  ungroup() %>% 
#  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE))


# Get data from GeoJSON LSOA_2011_IMD
attach(glue("{getwd()}/LSOA_2011_IMD"))
data.LSOA_2011_IMD <- data.LSOA_2011_IMD

## Smaller LSOA data set
data.LSOA_2011_IMD.NENC <-
  data.LSOA_2011_IMD %>% 
  left_join(data.lsoa_to_icb.lu, by = c('lsoa11cd' = 'LSOA11CD')) %>% 
  filter(Flag_NEY) 

## save
save(data.LSOA_2011_IMD.NENC,file = glue("{getwd()}/LSOA_2011_IMD_NENC"))

# Get data from GeoJSON CCG 2021 BSC
attach(glue("{getwd()}/CCG_2021_BSC"))
data.CCG_2021_BSC <- data.CCG_2021_BSC

data.ccg_to_icb.lu <- read_csv('CCG_to_ICB.csv') %>% 
  filter(`CCG Code` %in% c('00L','00N','00P','01H','13T','16C','84H','99C')) %>% 
  mutate(NENC = TRUE)

data.CCG_2021_BSC.NENC <-
  data.CCG_2021_BSC %>% 
  mutate(CCG21NM = str_to_upper(CCG21NM)) %>% 
  left_join(data.ccg_to_icb.lu, by = c("CCG21NM" = "CCG"))  %>% 
  filter(NENC == TRUE)


## save
save(data.CCG_2021_BSC.NENC,file = glue("{getwd()}/CCG_2021_BSC_NENC"))

rm(data.LSOA_2011_IMD)

```


```{r webdata, include=FALSE}

# Get data from ICS 2021 BFC
attach(glue("{getwd()}/Eng_ICB_2022_BUC"))
data.Eng_ICB_2022_BUC <- data.Eng_ICB_2022_BUC

data.Eng_ICB_2022_BUC <- data.Eng_ICB_2022_BUC %>% 
mutate(NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE ) %>% as.factor())

# Get data from GeoJSON MSOA 2021 BSC
attach(glue("{getwd()}/MSOA_2021_BSC_NEY"))
data.LSOA_2011_IMD.NENC <- data.LSOA_2011_IMD.NENC

# Get data from GeoJSON CCG 2021 BSC
attach(glue("{getwd()}/CCG_2021_BSC_NEY"))
data.CCG_2021_BSC.NEY <- data.CCG_2021_BSC.NEY

# Load Foundry data
#raw.data.population <- read_excel(ExcelWorkbook,sheet = "Population")

#data.population <-
#  raw.data.population 

# %>% select(-c(Row_Num)) %>% 
#  mutate(Spring_UptakePercent = Spring_Uptake / Spring_Pop)

#join
#data.MSOA_2021_BSC.NEY <-
#  data.MSOA_2021_BSC.NEY %>% 
#  left_join(data.population, by="MSOA11CD", suffix = c("",".y")) 

## Labels 
data.LSOA_2011_IMD.NENC <-
  data.LSOA_2011_IMD.NENC %>%
  mutate(label_imd = glue('
  
IMD Decile: {IMD_Decile}
{lsoa11nm}: {lsoa11cd}
LAD: {LADnm}
ICB: {ICB22NM}
IMD Rank: {IMD_Rank}
IMD Score: {IMDScore}
Total Population: {TotPop}
')) %>% mutate(label_imd_rank = glue('
IMD Rank: {IMD_Rank}
{lsoa11nm}: {lsoa11cd}
LAD: {LADnm}
ICB: {ICB22NM}
IMD Decile: {IMD_Decile}
IMD Score: {IMDScore}
Total Population: {TotPop}
')) ## Makes labels HTML data.LSOA_2011_IMD.NENC$label_imd <- lapply(data.LSOA_2011_IMD.NENC$label_imd,HTML) data.LSOA_2011_IMD.NENC$label_imd_rank <- lapply(data.LSOA_2011_IMD.NENC$label_imd_rank,HTML) ``` ```{r localdata, include=FALSE} # Get data for sites downloaded from Foundry raw.data.Sites <- read_excel(ExcelWorkbook, sheet = "Defibs") # Join Sites data.Sites <- raw.data.Sites %>% rename(Site_Name = location_name ,Site_ODS_code = unique_identifier ,LAD = ladnm ,Postcode = address_post_code ) %>% ##filter(Site_Type != "LVS - Detained Estate") %>% filter(!is.na(lat)) %>% filter(lat != 0) %>% mutate( ICS = "CNE" ,Site_Type = defibrillators_availability ,Current_Status = defibrillators_access_type ,Site_Colour = Site_Type ,Site_Type = as_factor(Site_Type) #,CCG = str_remove_all(CCG,"NHS ") %>% str_remove_all(" CCG") ,across(.cols = c(lat,long), .fns = as.numeric) ,across(where(is.character), .fns = as.factor) ) ##Columns data.Sites <- data.Sites %>% select(Site_Name ,Site_Type ,ICS #,CCG ,LAD ,Postcode ,Current_Status ,Site_Colour ,lat ,long ) ## Labels data.Sites <- data.Sites %>% mutate(label_text = glue( '
{Site_Name}
Type: {Site_Type}
Status: {Current_Status}
LAD: {LAD}, Postcode: {Postcode}
')) ## Makes labels HTML data.Sites$label_text <- lapply(data.Sites$label_text,HTML) ``` ```{r functions, include=FALSE} ## Colours for markers getColour <- function(Sites) { sapply(Sites$Site_Colour, function(Site_Colour) { case_when(Site_Colour == "24/7 Access" ~ "green" ,Site_Colour == "Varied Access" ~ "orange" ,TRUE ~ "black" ) } )} # glyphs for markers getGlyph <- function(Sites) { sapply(Sites$Current_Status, function(Current_Status) { case_when( Current_Status == "Public" ~ "map" ,Current_Status == "Restricted" ~ "lock" ,TRUE ~ "circle-xmark" ) %>% fa(position = "middle",margin_right = 0) })} # Makes icons icons.sites <- awesomeIcons(text = getGlyph(data.Sites) ,iconColor = 'white' ,markerColor = getColour(data.Sites) ) ## Colours for polygons PalDecile.colour <- inferno(10)[1:10] PalRank.colour <- mako(10)[1:10] legend_labels_Decile <- c('1 (most deprived)' ,'2' ,'3' ,'4' ,'5' ,'6' ,'7' ,'8' ,'9' ,'10 (least deprived)') PalDecile <- colorBin( palette = c(PalDecile.colour) , domain = legend_labels_Decile , bins = c(1,2,3,4,5,6,7,8,9,10,Inf) , na.color = '#F8F8F8FF') legend_labelsRank <- c('1 - 3,199 (most deprived)' ,'3,200 - 6,399' ,'6,400 - 9,599' ,'9,600 - 12,799' ,'12,800 - 15,999' ,'16,000 - 19,199' ,'19,200 - 22,399' ,'22,400 - 25,599' ,'25,600 - 28,799' ,'28,800 - 31,999' ,'32,000 + (least deprived)') PalRank <- colorBin( palette = c(PalRank.colour) , domain = legend_labelsRank , bins = c(0,3200,6400,9600,12800,16000,19200,22400,25600,28800,32000,Inf) , na.color = '#F8F8F8FF') ## Colours for out of Area OOA.colour <- '#808080E6' PalOOA <- colorFactor(palette = c(OOA.colour,'#00000000') , levels = c(FALSE,TRUE) , alpha = TRUE , na.color = '#00000000') ``` ```{r buildmap, include=FALSE} share.data.Sites <- SharedData$new(data.Sites ,group="sites") #share.data.Sites <- data.Sites plot.map <- leaflet() %>% setView(lat = 54.7, lng = -2.0, zoom = 09) %>% # ICS addPolygons(data = data.Eng_ICB_2022_BUC , fillColor = ~PalOOA(data.Eng_ICB_2022_BUC$NEY) , color = 'black', weight = 3, smoothFactor = 0.5) %>% # CCG addPolygons(data = data.CCG_2021_BSC.NEY , fillColor = "#FFFFFFFF" , color = 'black', weight = 3, smoothFactor = 0.5, dashArray = '4') %>% # Chloropleth layers # IMD Decile addPolygons(data = data.LSOA_2011_IMD.NENC , group = "IMD Decile" , fillColor = ~PalDecile( data.LSOA_2011_IMD.NENC$IMD_Decile) , smoothFactor = 0.2, fillOpacity = 0.4 , opacity = 1, color = ~PalDecile( data.LSOA_2011_IMD.NENC$IMD_Decile), weight = 0.5 , highlightOptions = highlightOptions(color = "#444444", weight = 1, bringToFront = TRUE) , label = data.LSOA_2011_IMD.NENC$label_imd ) %>% # IMD Rank addPolygons(data = data.LSOA_2011_IMD.NENC , group = "IMD Rank" , fillColor = ~PalRank(data.LSOA_2011_IMD.NENC$IMD_Rank) , smoothFactor = 0.2, fillOpacity = 0.4 , opacity = 1, color = ~PalRank( data.LSOA_2011_IMD.NENC$IMD_Rank), weight = 0.5 , highlightOptions = highlightOptions(color = "#444444", weight = 1, bringToFront = TRUE) , label = data.LSOA_2011_IMD.NENC$label_imd_rank ) %>% # Sites addAwesomeMarkers( data = share.data.Sites , lat = ~lat, lng = ~long, icon = icons.sites, label = data.Sites$label_text) %>% # Layer controls addProviderTiles(provider = providers$CartoDB.Positron) %>% addLegend(data = data.LSOA_2011_IMD.NENC , position = "topright",labFormat = function(type, cuts, p){paste0(legend_labels_Decile)} , pal = PalDecile, values = ~ data.LSOA_2011_IMD.NENC$IMD_Decile , title = HTML("IMD Decile")) %>% addLegend(data = data.LSOA_2011_IMD.NENC , position = "topright",labFormat = function(type, cuts, p){paste0(legend_labelsRank)} , pal = PalRank, values = ~ data.LSOA_2011_IMD.NENC$IMD_RANK , title = HTML("IMD Rank")) %>% addLayersControl(baseGroups = c("IMD Decile","IMD Rank") ,position = "bottomleft" ,options = layersControlOptions(collapsed = FALSE) ) ``` ```{r build_datatable, include=FALSE} #plot.table.sites <- # datatable(share.data.Sites # , rownames = FALSE # , extensions=c("Buttons","Scroller") # , style="bootstrap" # , class="compact" # , width="100%" # , options = list(deferRender=TRUE # , scrollY="200px" # , scroller=TRUE # , dom = "Bfrtip" # , searching = FALSE # , buttons = c('copy', 'csv') # , columnDefs = list( list(visible=FALSE, targets = c(seq(12,15) ) ) ) ) # , colnames = c( # "Name" ##0 #,"ODS Code" #,"Type" #,"ICB" #,"CCG" #,"LAD" #,"Postcode" #,"Current Status" #,"Spring `23 VVE" #,"Mean Week VVE" #,"Median Week VVE" #,"Max Week VVE" #,"12" #,"13" #,"14" #,"15" #)) %>% #formatRound(columns = 9:12, digits = 0) # # # # ###Columns #data.Sites <- # data.Sites %>% # select(Site_Name # ,Site_ODS_code # ,Site_Type # ,ICS # ,CCG # ,LAD # ,Postcode # ,Current_Status # ,Spring23_VVEs # ,Spring23_Mean_VVE_perWeek # ,Spring23_Median_VVE_perWeek # ,Spring23_Max_VVE_perWeek # ,Site_Colour # ,lat # ,long # ,label_text # ) ``` Map ===================================== Column {.sidebar} ------------------------------------- ### Filters Total Sites: `r summarywidget(data = share.data.Sites, statistic = "count", digits = 0)`
#### Location ```{r map_filter_area} #filter_select(id = "icb" # ,label = "ICB" # ,group = ~ICS # ,allLevels = FALSE # ,multiple = TRUE # ,sharedData = share.data.Sites) # #filter_select(id = "ccg" # ,label = "CCG" # ,group = ~CCG # ,allLevels = FALSE # ,multiple = TRUE # ,sharedData = share.data.Sites) filter_select(id = "lad" ,label = "LAD" ,group = ~LAD ,allLevels = FALSE ,multiple = TRUE ,sharedData = share.data.Sites) ``` #### Type ```{r map_filter_type} ## status filter_checkbox(id = "Current_Status" ,label = "Current Status" ,group = ~Current_Status ,inline = FALSE ,columns = 2 ,sharedData = share.data.Sites) ## type filter_checkbox(id = "type" ,label = "Site Type" ,group = ~Site_Type ,inline = FALSE ,sharedData = share.data.Sites) ``` Column ------------------------------------- ### `r glue("NENC DFIB Sites
Data updated: { format(ExtractDate,'%Y-%m-%d')}")` ```{r plot_map, fig.width=9, fig.height=4} #Row {data-height=700} #------------------------------------- # plot plot.map ``` ```{r clean, include=FALSE, warning=FALSE} # clean gc() # remove temp rm(raw.data.population) rm(raw.data.Sites) ```